home *** CD-ROM | disk | FTP | other *** search
- '╔════╡ MAKEQLBV.BAS - .QLB maker utility (enhanced) for BASIC programs ╞════╗
- '║ ║
- '║ Enhancements by David A. Violette, 12 Michaud Ave, Lewiston ME 04240 ║
- '║ 207+783-6171 (eves). CompuServe 76456,1602 12 Aug 90 ║
- '║ ║
- '║ I have changed this program so that the file Objects.obj is named ║
- '║ EXTERNAL.OBJ, and the file is retained instead of KILLed. By including ║
- '║ EXTERNAL.OBJ in the LINK response file, a separate .LIB is not needed, ║
- '║ since the external objects are already referenced in EXTERNAL.OBJ, and ║
- '║ the program can be compiled and linked from the command line using the ║
- '║ response file. This change allows easy and smallest .QLB but adds easy ║
- '║ command line compilation/link using MAKE or NMAKE. See SUB MakeObj as ║
- '║ well as this main module. ║
- '║ ║
- '║ MAKEQLBV may be invoked from the command line in one of several options: ║
- '║ ║
- '║ (1) MAKEQLBV prog.BAS,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,_ ║
- '║ QBXQLB; ║
- '║ ║
- '║ (2) MAKEQLBV prog.LST,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,_ ║
- '║ QBXQLB; ║
- '║ ║
- '║ (3) MAKEQLBV @response.ext ║
- '║ ║
- '║ prog is the name of the program. PRO7 is Crescent Software's QuickPak ║
- '║ Professional library for BC7; this is searched for routines I might ║
- '║ use in prog. ║
- '║ ║
- '║ DTFTMTER and FINANCER are libraries supplied by Microsoft with BC7 - ║
- '║ these are searched when I use routines from them. ║
- '║ ║
- '║ progUITB started as the UITBEFR library supplied by Microsoft with ║
- '║ BC7, but I have modified several of the routines for use in prog and ║
- '║ built this special library. ║
- '║ ║
- '║ QBXQLB is the link library supplied by Microsoft with BC7. Change ║
- '║ this to match the compiler you are using (eg: BQLB45.LIB). ║
- '║ ║
- '║ The first option will scan the source file given as the first parameter, ║
- '║ plus any other module names listed in a prog.MAK file if present, to find ║
- '║ the required routines. ║
- '║ ║
- '║ The second option will get the names of the routines by reading a ║
- '║ prog.LST file. MAKEQLB (and MAKEQLBV) will create the prog.LST file when ║
- '║ the first option is used, but you may manually edit this file to add or ║
- '║ delete names of routines directly. Using prog.LST will greatly speed up ║
- '║ processing the QLB since MAKEQLB (and MAKEQLBV) won't have to scan all ║
- '║ the source files. ║
- '║ ║
- '║ The third option allows use of a response file to shorten the command ║
- '║ line. The response file name is given immediately after the "@", and the ║
- '║ response file contains the items required on the command line, given in ║
- '║ the same way they would on a command line. The five parameters are ║
- '║ described in Crescent's intro below (copied from their MAKEQLB.BAS ║
- '║ module). I use two versions of the response file - one with prog.BAS as ║
- '║ the source file name, and one with prog.LST as the source file name. The ║
- '║ first will act as option (1), the second as (2). ║
- '║ ║
- '║ An example response file for option (1) operation might be as follows: ║
- '║ ║
- '║ prog.BAS,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,+ ║
- '║ QBXQLB; ║
- '║ ║
- '║ An example response file for option (2) operation might be as follows: ║
- '║ ║
- '║ prog.LST,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,QBXQLB; ║
- '║ ║
- '║ The response file must have the parameters separated by commas and spaces ║
- '║ as shown. If MAKEQLB (and MAKEQLBV) find a "+" it is replaced with a " " ║
- '║ and the next line is appended. Essentially, the response file replaces ║
- '║ command line parameters and allows longer lines to be edited using the + ║
- '║ as a continuation symbol. ║
- '║ ║
- '║ A major advantage in using MAKEQLBV instead of MAKEQLB is that the file ║
- '║ EXTERNAL.OBJ is saved for use in LINKing. This avoids having to build a ║
- '║ separate prog.LIB library as well as the prog.QLB, because EXTERNAL.OBJ ║
- '║ can be used to identify the external routines to be pulled from other ║
- '║ libraries. This option is only available when you compile and link from ║
- '║ the command line, however. ║
- '║ ║
- '║ To use EXTERNAL.OBJ, simply include it in your list of object files to ║
- '║ LINK. I prefer to use a LINK response file, and I also use the MAKE ║
- '║ utility with a companion description file. The MAKE prog.DES file might ║
- '║ look like this: ║
- '║ ║
- '║ prog.obj: prog.bas ║
- '║ bc prog /d/o/w/ah/fs; ║
- '║ ║
- '║ progmod1.obj: progmod1.bas ║
- '║ bc progmod1 /d/o/w/ah/fs; ║
- '║ ║
- '║ progmod2.obj: progmod2.bas ║
- '║ bc progmod2 /d/o/w/ah/fs; ║
- '║ ║
- '║ progmod3.obj: progmod3.bas ║
- '║ bc progmod3 /d/o/w/ah/fs; ║
- '║ ║
- '║ progmod4.obj: progmod4.bas ║
- '║ bc progmod4 /d/o/w/ah/fs; ║
- '║ ║
- '║ prog.exe: prog.obj progmod1.obj progmod2.obj progmod3.obj progmod4.obj ║
- '║ link @prog.rsp ║
- '║ ║
- '║ The link response file prog.rsp might look like this: ║
- '║ ║
- '║ prog progmod1 + progmod2 + (progmod3) + (progmod4) + EXTERNAL.OBJ ║
- '║ prog ║
- '║ prog ║
- '║ PRO7.LIB + progUITB.LIB + DTFMTER.LIB + FINANCER.LIB ║
- '║ ║
- '║ I have also added a feature that writes the unreferenced items to a file ║
- '║ for each module, where the filename is modulename.UNR. This aids in ║
- '║ cleaning up the modules. See SUB ReadSource. ║
- '║ ║
- '║ I have added a variable LibDir$ which uses any LIB environment variable ║
- '║ to find the necessary libraries. See main module. ║
- '║ ║
- '╚═══════════════════════════════════════════════════════════════════════════╝
- '┌─────────┤ MAKEQLB.BAS - .QLB maker utility for BASIC programs ├───────────┐
- '│ │
- '│Copyright (c) 1988, 1989 Crescent Software │
- '│by Don Malin and Chris May with user input enhancements by Ken White │
- '│Notes: │
- '│ Source files must be saved in Text format. │
- '│ │
- '│ Five parameters are required for this program -- one or more main │
- '│ program names, the new .QLB file name, a list file name (NUL for no │
- '│ list), one or more library names from which to extract the needed │
- '│ routines, and the BQLB## support library. As with LIB and LINK, a │
- '│ semicolon (;) can be used to force MAKEQLB to use its defaults. │
- '│ │
- '│ The program will check for routines that were declared but never │
- '│ used or BASIC procedures that were defined but never used. │
- '│ Declared unreferenced routines will not be added to the new Quick │
- '│ Library. │
- '│ │
- '│ If a list file (.LST) is given in place of the source file name, │
- '│ the program will make the quick library from the list instead of │
- '│ searching the source files for external references. │
- '│ │
- '│MAKEQLB basicprogram1 [Basicprogram2], quicklib[.qlb], listfile[.lst],_ │
- '│ library[.lib] [library2[.lib], [bqlb##][;] │
- '│ │
- '│Compile and Link as follows: │
- '│ BC makeqlb /ah /s [/fpa] /o; │
- '│ LINK /e/noe makeqlb [nocom] [nolpt] [smallerr],,,pro; │
- '│ │
- '│ [] = optional items. "/fpa" and "smallerr" are available with │
- '│ BASCOM 6, "no" object files may be included with your compiler. │
- '│ │
- '└───────────────────────────────────────────────────────────────────────────┘
-
- DEFINT A-Z
-
-
- '~~~~~ Define Constants
- CONST BQLB$ = "QBXQLB.LIB" 'Default BASIC link library (BC 7)
- CONST BASProc = -1 'Flag for BASIC procedures
- CONST RefedProc = -2 'Flag for referenced procedures
- CONST MaxProcs = 300 'Maximum number of procedures
- CONST ProcLen2 = 40 'Maximum length for a procedure name
- CONST ProcLen = 30 'Maximum length for module level
- ' procedure names
- ' Must be a power of 2 minus 2
- ' [ie. 30 = (2 ^ 5) - 2]
- ' because the TYPE below is used to
- ' DIM a huge array whose size could
- ' span multiple segments.
-
- '~~~~~ Define TYPEs for procedure Info
- TYPE ModProcs 'Module procedure information
- ProcName AS STRING * ProcLen 'Procedure name
- Count AS INTEGER 'Number of references in module
- END TYPE
-
- TYPE ProcInfo 'Procedure information for program
- ProcName AS STRING * ProcLen2 'Procedure name
- AliasName AS STRING * ProcLen2 'ALIAS'ed name
- BasFlag AS INTEGER 'Flag field for BASIC procedure
- Refed AS INTEGER 'Flag field shows referenced proc.
- END TYPE
-
-
- '~~~~~ Declare routines
- DECLARE FUNCTION Blanks% (Strng$)
- DECLARE FUNCTION CheckSum% (Strg$)
- DECLARE FUNCTION Exist% (FileName$)
- DECLARE FUNCTION NoPath$ (FileName$)
- DECLARE FUNCTION NoXtn$ (FileName$)
- DECLARE FUNCTION Null% (Text$)
- DECLARE FUNCTION QPLen% (Text$)
- DECLARE FUNCTION UserInp$ (NoSemi, Prompt$, Default$)
- DECLARE FUNCTION Valid% (FileName$)
-
- DECLARE SUB CheckName (FileName$)
- DECLARE SUB FatalErr (Message$)
- DECLARE SUB FindT (SEG Element AS ANY, TypeWidth, NumEls, Search$)
- DECLARE SUB GetParms (FileName$, NewLib$, LstFile$, InpLibs$, BASLib$)
- DECLARE SUB MakeObj (Subs, Procs() AS ProcInfo, LstFile$)
- DECLARE SUB QPrint0 (Text$, Clr)
- DECLARE SUB ReadSource (FileName$, Procs() AS ProcInfo, Subs)
- DECLARE SUB SortT (SEG Element AS ANY, NumEls, Dir, TypeWidth, Offset, FieldWidth)
- DECLARE SUB SrchPath (FileName$, Paths$, NotFound)
-
-
- '~~~~~ Dim Procedure information array
- DIM Procs(1 TO MaxProcs) AS ProcInfo
-
- DIM SHARED ObjName$, RspName$, LibDir$
- ObjName$ = ENVIRON$("TMP") + "External.obj" 'Saved Object file
- RspName$ = ENVIRON$("TMP") + "DonMalin.rsp" 'Temporary response file for LINK
- LibDir$ = ENVIRON$("LIB") + "\"
- OtherObjName$ = ""
-
- '~~~~~ Print Banner
- PRINT
- PRINT "Quick-Library Maker Utility Version 1.03"
- PRINT "Copyright (c) 1988, 1989 Crescent Software"
- PRINT "This version was modified by David A. Violette, CompuServe 76456,1602."
- PRINT "For personal use only; Crescent Software still owns the Copyright."
- PRINT "Modified version made available by permission from Crescent Software."
- PRINT
-
-
- '~~~~~ Get input parameters from COMMAND$ or by prompting the User
- GetParms FileName$, NewLib$, LstFile$, InpLibs$, BASLib$
-
-
-
- Subs = 0 'Init. number of procs.
-
-
- '~~~~~ Read each Main Module or List file specified
- look = 1
- DO
- Spac = INSTR(look, FileName$, " ")
- IF Spac = 0 THEN Spac = QPLen%(FileName$) + 1
- SourceName$ = LTRIM$(MID$(FileName$, look, Spac - look))
- IF INSTR(SourceName$, ".") = 0 THEN SourceName$ = SourceName$ + ".BAS"
-
-
- '~~~~~ Are we using a List file (.LST)?
- SELECT CASE MID$(FileName$, INSTR(FileName$, ".") + 1)
- CASE "LST"
-
- '~~~~~ Read the routine names into array (Procs)
- CheckName FileName$
- OPEN FileName$ FOR INPUT AS #1
- Blank$ = SPACE$(ProcLen2)
- DO UNTIL EOF(1)
- Subs = Subs + 1
- IF Subs > MaxProcs THEN FatalErr "Too many procedures!"
- LINE INPUT #1, Procs(Subs).ProcName
- IF Procs(Subs).ProcName = Blank$ THEN
- Subs = Subs - 1
- ELSE
- Procs(Subs).ProcName = UCASE$(Procs(Subs).ProcName)
- END IF
- LOOP
- CLOSE #1
-
- CASE "OBJ"
- OtherObjName$ = OtherObjName$ + " " + FileName$
-
- CASE ELSE
-
- '~~~~~ Search source files for external references
- ReadSource SourceName$, Procs(), Subs
-
- END SELECT
-
- look = Spac + 1
- LOOP UNTIL Spac = QPLen%(FileName$) + 1
-
-
-
- '~~~~~ Bail out if no external routines found.
- IF Subs = 0 THEN FatalErr "No external routines required."
-
-
- '~~~~~ Sort the procedure names
- SortT Procs(1), Subs, 0, ProcLen2 * 2 + 4, 0, ProcLen2
-
-
- '~~~~~ Create the object and list files
- MakeObj Subs, Procs(), LstFile$
-
-
- '~~~~~ Display status message
- LOCATE , 1
- QPrint0 SPACE$(78), -1
- QPrint0 "Creating " + NewLib$, -1
-
-
- '~~~~~ SHELL out to LINK.EXE to build the new Quick Library.
- LINK$ = "LINK /q/noe/seg:512 " + ObjName$ + OtherObjName$ + "," + NewLib$ + ",nul," + InpLibs$ + " " + BASLib$ + "; > LinkErr$.Tmp"
-
-
-
- IF QPLen%(LINK$) < 127 THEN 'Check length of command line
- SHELL LINK$
- ELSE 'Line too long
- '~~~~~ Create a LINK response file
- OPEN RspName$ FOR OUTPUT AS #1
- PRINT #1, "/q/noe/seg:512 " + ObjName$ + OtherObjName$ + ","
- PRINT #1, NewLib$ + ",nul,"
- PRINT #1, LibDir$ + InpLibs$ + "+"
- PRINT #1, LibDir$ + BASLib$ + ";"
- CLOSE #1
-
- SHELL "LINK @" + RspName$ + " > LinkErr$.Tmp"
- KILL RspName$
- END IF
-
- 'KILL ObjName$ No, save it for use in making .LIB (DAV)
- IF NOT Exist("LinkErr$.Tmp") THEN FatalErr "Cannot find [LINK.EXE]!"
-
-
- '~~~~~ Check for LIB.EXE errors (OBJects not found)
- LOCATE , 1
- LinkErr = 0
- OPEN "LinkErr$.Tmp" FOR INPUT AS #1 'Open LIB.EXE message file
- DO UNTIL EOF(1)
- LINE INPUT #1, Text$ 'Read a line
- 'Was there an error?
- IF INSTR(Text$, "error") OR INSTR(UCASE$(Text$), "MEMORY") THEN
- BEEP 'Yes, display the message
- LinkErr = -1
- LOCATE , 1
- PRINT SPACE$(79)
- PRINT Text$
- DO UNTIL EOF(1)
- LINE INPUT #1, Text$
- PRINT Text$
- LOOP
- END IF
- LOOP 'Look for more
- CLOSE #1
- KILL "LinkErr$.Tmp"
-
-
- '~~~~~ Display status message
- IF NOT LinkErr THEN
- QPrint0 SPACE$(78), -1
- PRINT
- PRINT NewLib$; " Created."
- END IF
-
-
-
- '~~~~~ Data used by "MakeObj" to create Object file header and footer.
- DATA 128,14,0,12,99,104,114,105,115,109,97,121,46,65,83,77,247,150,39
- DATA 0,0,6,68,71,82,79,85,80,13,67,72,82,73,83,77,65,89,95,84,69,88,84
- DATA 4,68,65,84,65,4,67,79,68,69,5,95,68,65,84,65,160,152,7,0,72,0
- DATA 0,3,5,1,16,152,7,0,72,0,0,6,4,1,14,154,4,0,2,255,2,95
- DATA 136,4,0,0,162,1,209,138,2,0,0,116
-
- '~~~~~ Check File Name for validity
- SUB CheckName (FileName$) STATIC
-
- IF NOT Valid%(FileName$) THEN
- FatalErr "`" + FileName$ + "' is not a valid file name!"
- END IF
-
- END SUB
-
- '~~~~~ Displays error message and ends the program
- SUB FatalErr (Message$) STATIC
-
- BEEP
- PRINT
- QPrint0 Message$ + " Program terminated.", -1
- PRINT
- END
-
- END SUB
-
- '~~~~~ Get Input Parameters from User
- SUB GetParms (FileName$, NewLib$, LstFile$, InpLibs$, BASLib$) STATIC
-
- FileName$ = ".BAS"
- InpLibs$ = "PRO7.LIB"
- BASLib$ = BQLB$
- NoSemi = 5
-
-
- '~~~~~ Get command line parameters from COMMAND$
- IF QPLen%(COMMAND$) THEN
-
- Param = 1
- P = 1
- CMD$ = COMMAND$
-
- '~~~~~ Check for a response file... allows use of "+" for continuation
- ' of lines.
- Rsp = INSTR(CMD$, "@")
- IF Rsp THEN
- L = LEN(CMD$)
- Rsp$ = ""
- I = Rsp + 1
- DO WHILE MID$(CMD$, I, 1) <> " "
- Rsp$ = Rsp$ + MID$(CMD$, I, 1)
- IF I = L THEN EXIT DO ELSE I = I + 1
- LOOP
- ResFx = FREEFILE
- OPEN "i", ResFx, Rsp$
- CMD$ = ""
- WHILE NOT EOF(ResFx)
- LINE INPUT #ResFx, ICmd$
- IF MID$(ICmd$, QPLen(ICmd$), 1) = "+" THEN MID$(ICmd$, QPLen(ICmd$), 1) = " "
- CMD$ = CMD$ + ICmd$
- WEND
- ICmd$ = ""
- CLOSE ResFx
- END IF
-
- DO
-
- '~~~~~ Parse out parameter looking for [,] or [;] or EOL
- PC = INSTR(P, CMD$, ",")
- IF PC = 0 THEN PC = INSTR(P, CMD$, ";")
- IF PC = 0 THEN PC = QPLen%(CMD$) + 1
- Temp$ = UCASE$(LTRIM$(RTRIM$(MID$(CMD$, P, PC - P))))
-
- '~~~~~ Assign parameters
- SELECT CASE Param
- CASE 1 'File Name
- FileName$ = Temp$
- IF FileName$ = "" THEN FatalErr "No Source File Name!"
-
- BaseName$ = NoXtn$(FileName$)
- IF BaseName$ = FileName$ THEN FileName$ = FileName$ + ext$
- NoSemi = 4
- CASE 2 'New Quick Library name
- NewLib$ = Temp$
- NoSemi = 3
- CASE 3 'List file name
- LstFile$ = Temp$
- NoSemi = 2
- CASE 4 'Input Library names
- InpLibs$ = Temp$
- NoSemi = 1
- CASE 5 'BASIC library name
- BASLib$ = Temp$
- NoSemi = 0
- CASE ELSE
- END SELECT
-
- Param = Param + 1 'Bump parameter number
- P = PC + 1
- LOOP UNTIL PC >= QPLen%(CMD$) OR MID$(CMD$, PC, 1) = ";" 'Get another
-
- END IF
-
-
- '~~~~~ Prompt User for parameters
- IF INSTR(COMMAND$, ";") = 0 THEN 'No semicolon, prompt User
- IF NoSemi = 5 THEN GOSUB GetSource
- IF NoSemi >= 4 THEN GOSUB GetNewLib
- IF NoSemi >= 3 THEN GOSUB GetListFile
- IF NoSemi >= 2 THEN GOSUB GetInputLibs
- IF NoSemi >= 1 THEN GOSUB GetBQLBLib
- PRINT
- END IF
-
-
- '~~~~~ Make default names for parameters if required
- IF QPLen%(NewLib$) = 0 THEN NewLib$ = NoPath$(BaseName$) + ".QLB"
- IF INSTR(NewLib$, ".") = 0 THEN NewLib$ = NewLib$ + ".QLB"
- CheckName NewLib$
-
- IF QPLen%(LstFile$) = 0 THEN LstFile$ = NoPath$(BaseName$) + ".LST"
- IF INSTR(LstFile$, ".") = 0 THEN LstFile$ = LstFile$ + ".LST"
- CheckName LstFile$
-
- IF QPLen%(InpLibs$) = 0 THEN InpLibs$ = "PRO.LIB"
-
- IF QPLen%(BASLib$) = 0 THEN BASLib$ = BQLB$
- IF INSTR(BASLib$, ".") = 0 THEN BASLib$ = BASLib$ + ".LIB"
- CheckName BASLib$
-
-
- '~~~~~ Search for required libraries using "LIB" environment variables
- LibPaths$ = ENVIRON$("LIB")
-
- P = 1
- DO 'Parse out individual names
- PC = INSTR(P, InpLibs$, " ")
- IF PC = 0 THEN PC = QPLen%(InpLibs$) + 1
- InpLib$ = LTRIM$(RTRIM$(MID$(InpLibs$, P, PC - P)))
-
- IF INSTR(InpLib$, ".") = 0 THEN InpLib$ = InpLib$ + ".LIB"
- CheckName InpLib$
-
- SrchPath InpLib$, LibPaths$, NotFound 'Check path for file
- IF NotFound THEN FatalErr InpLib$ + " not found!"
-
- P = PC + Blanks(MID$(InpLibs$, PC))
- LOOP UNTIL P > LEN(InpLibs$)
-
-
- SrchPath BASLib$, LibPaths$, NotFound 'Check paths for BASIC library
- IF NotFound THEN FatalErr BASLib$ + " not found!"
-
- EXIT SUB
-
-
- '~~~~~ Get Source file name
- GetSource:
- FileName$ = UserInp$(NoSemi, "Main Module Name", FileName$)
-
- IF FileName$ = ".BAS" THEN END 'Check validity
- BaseName$ = NoXtn$(FileName$)
- IF BaseName$ = FileName$ THEN FileName$ = FileName$ + ext$
- RETURN
-
-
- '~~~~~ Get output library name
- GetNewLib:
- IF QPLen%(NewLib$) THEN
- Default$ = NewLib$
- ELSE
- Default$ = NoPath$(BaseName$) + ".QLB"
- END IF
-
- NewLib$ = UserInp$(NoSemi, "Output Library Name", Default$)
- RETURN
-
-
- '~~~~~ Get list file name
- GetListFile:
- IF QPLen%(LstFile$) THEN
- Default$ = LstFile$
- ELSE
- Default$ = NoPath$(BaseName$) + ".LST"
- END IF
-
- LstFile$ = UserInp$(NoSemi, "List File Name", Default$)
- RETURN
-
-
- '~~~~~ Get input library names
- GetInputLibs:
- InpLibs$ = UserInp$(NoSemi, "Input Libraries", InpLibs$)
- RETURN
-
-
- '~~~~~ Get BASIC library [BQLB] name
- GetBQLBLib:
- BASLib$ = UserInp$(NoSemi, "BQLB## Library Name", BASLib$)
- RETURN
-
-
- END SUB
-
- '~~~~~ Create an Object file consisting of EXTRN declarations
- '~~~~~ Also writes the List File
- SUB MakeObj (Subs, Procs() AS ProcInfo, LstFile$) STATIC
-
- LOCATE , 1
- QPrint0 "Creating temporary file: `External.obj'.", -1
-
-
- '~~~~~ Create files
- IF Exist%(ObjName$) THEN KILL ObjName$
- OPEN ObjName$ FOR BINARY AS #1
- OPEN LstFile$ FOR OUTPUT AS #2
-
-
- '~~~~~ Compose OBJ Header string
- a$ = SPACE$(86)
- FOR I = 1 TO 86
- READ B
- MID$(a$, I) = CHR$(B)
- NEXT
- PUT #1, , a$
-
-
- '~~~~~ Compose external procedure names into OBJ form
- I = 1 'initial value
- DO
- Count = 0
- FileList$ = ""
-
- FOR N = I TO Subs 'For each procedure name
-
- IF Procs(N).BasFlag = 0 THEN 'If it's an external proc.
- 'print name to list file
- IF NOT Null%(Procs(N).AliasName) THEN
- Temp$ = RTRIM$(Procs(N).AliasName)
- ELSE
- Temp$ = RTRIM$(Procs(N).ProcName)
- END IF
-
- PRINT #2, Temp$
-
- L = QPLen%(Temp$)
- Count = Count + L + 2
- IF Count > 1018 THEN EXIT FOR
- FileList$ = FileList$ + CHR$(L) + Temp$ + CHR$(0)
- ELSE
-
- END IF
-
- NEXT
-
- Lng = QPLen%(FileList$) + 1
- FileList$ = CHR$(140) + CHR$(Lng MOD 256) + CHR$(Lng \ 256) + FileList$
- FileList$ = FileList$ + CHR$(CheckSum(FileList$))
- PUT #1, , FileList$
- I = N
-
- LOOP WHILE I <= Subs
-
-
- '~~~~~ Compose OBJ Footer
- a$ = SPACE$(12)
- FOR I = 1 TO 12
- READ B
- MID$(a$, I) = CHR$(B)
- NEXT
- PUT #1, , a$
-
-
- CLOSE #1, #2
-
- END SUB
-
- FUNCTION NoPath$ (FileName$) STATIC
-
- Test$ = ":\"
- FOR N = QPLen(FileName$) TO 1 STEP -1
- IF INSTR(Test$, MID$(FileName$, N, 1)) THEN EXIT FOR
- NEXT
-
- NoPath$ = MID$(FileName$, N + 1)
-
- END FUNCTION
-
- '~~~~~ Returns the base part of a file name
- FUNCTION NoXtn$ (FileName$) STATIC
-
- Per = INSTR(FileName$, ".")
- Spac = INSTR(FileName$, " ")
- IF Spac = 0 THEN Spac = QPLen%(FileName$) + 1
-
- IF Per > 0 AND Per < Spac THEN
- NoXtn$ = LEFT$(FileName$, Per - 1)
- ELSE
- NoXtn$ = LEFT$(FileName$, Spac - 1)
- END IF
-
- END FUNCTION
-
- '~~~~~ Read Source files looking for external routines and dead code
- SUB ReadSource (FileName$, Procs() AS ProcInfo, Subs) STATIC
-
- RtnTerm$ = " -)(%!#&@$:" + CHR$(9) 'Terminators for SUB/FUNCTION names
- FastLoadSave$ = CHR$(252) + CHR$(19)
-
- REDIM KWord$(3) 'Keyword table for finding procedures
- KWord$(0) = "FUNCTION "
- KWord$(1) = "SUB "
- KWord$(2) = "CALL "
- KWord$(3) = "CALLS "
-
-
- CheckName FileName$
-
- '~~~~~ Parse out file's path name
- Path$ = LEFT$(FileName$, INSTR(FileName$, NoPath$(FileName$)) - 1)
-
-
- '~~~~~ Load up the .MAK file if there is one.
- MakeName$ = NoXtn$(FileName$) + ".MAK"
-
- IF Exist%(MakeName$) THEN
- OPEN MakeName$ FOR INPUT AS #1
-
- Modules = 0 'Count the number of modules
- DO UNTIL EOF(1)
- LINE INPUT #1, Text$
- IF QPLen%(LTRIM$(Text$)) THEN Modules = Modules + 1
- LOOP
- CLOSE #1
-
- REDIM Make$(Modules) 'Make array for module names
- OPEN MakeName$ FOR INPUT AS #1
-
- FOR M = 1 TO Modules 'Read the module names
- LINE INPUT #1, Make$(M)
- IF QPLen%(Make$(M)) THEN
- 'Add a path name if needed
- IF INSTR(Make$(M), "\") = 0 AND INSTR(Make$(M), ":") = 0 THEN
- Make$(M) = Path$ + Make$(M)
- END IF
- IF INSTR(Make$(M), ".") = 0 THEN Make$(M) = Make$(M) + ".BAS"
- IF NOT Exist%(Make$(M)) THEN FatalErr Make$(M) + " not found!"
- ELSE
- M = M - 1
- END IF
- NEXT
-
- CLOSE #1
-
- ELSE 'One module
-
- Modules = 1
- REDIM Make$(1)
- Make$(1) = FileName$
-
- END IF
- 'See if we have enough memory
- IF FRE(-1) < ((MaxProcs + 1) * Modules * CLNG(ProcLen + 2)) + 1028& THEN
- FatalErr "Not enough memory (too many modules)!"
- END IF
- 'Array for module level procs.
- REDIM ModSub(MaxProcs, 1 TO Modules) AS ModProcs
- Rtn$ = SPACE$(ProcLen2) 'Work space for proc. names
-
-
-
- '~~~~~ Search All Files for Procedure Names
- LOCATE , 1
- QPrint0 "Examining ", -1
- LOCATE , 11
-
-
- FOR M = 1 TO Modules 'Examine each module
- Handle = 1 'File handle for module
-
- IF NOT Exist%(Make$(M)) THEN FatalErr "Cannot find " + Make$(M) + "!"
-
- OPEN Make$(M) FOR INPUT AS #Handle 'Open the module
-
- QPrint0 SPACE$(68), -1
- QPrint0 Make$(M), -1
-
-
- '~~~~~ Read until end of module
- DO UNTIL Handle = 1 AND EOF(1)
-
- DO WHILE EOF(Handle) 'Close include file when done
- CLOSE #Handle
- Handle = Handle - 1
- IF Handle = 1 THEN 'Redisplay module name
- QPrint0 SPACE$(68), -1
- QPrint0 Make$(M), -1
- EXIT DO
- END IF
- LOOP
- IF Handle = 1 AND EOF(1) THEN EXIT DO
-
- Ky$ = INKEY$ 'Check for Ctrl C
- IF QPLen%(Ky$) THEN
- IF ASC(Ky$) = 3 THEN FatalErr ""
- END IF
-
-
- LINE INPUT #Handle, Text$ 'Read a line of text
- Text$ = UCASE$(Text$) 'Make it upper case
-
- 'Test for binary file (Fast
- ' Load and Save)
- IF INSTR(Text$, FastLoadSave$) THEN
- FatalErr "Cannot process QuickBASIC - Fast Load and Save files!"
- END IF
-
-
-
- Length = INSTR(Text$, "'") - 1 'Get Length without comments
- IF Length = -1 THEN Length = INSTR(Text$, "REM ") - 1
- IF Length = -1 THEN Length = QPLen%(Text$)
-
-
-
- '~~~~~ Look for INCLUDE files
- Inc = INSTR(Text$, "$INCLUDE:")
-
- IF Inc THEN
-
- IF INSTR(Length + 2, Text$, "'") > Inc THEN
- Inc = INSTR(Inc, Text$, "'") + 1
- Inc2 = INSTR(Inc, Text$, "'")
- IF Inc2 > Inc THEN
- IncName$ = MID$(Text$, Inc, Inc2 - Inc)
- IF INSTR(IncName$, ".") = 0 THEN IncName$ = IncName$ + ".BAS"
- 'Add path to include name
- IF QPLen%(Path$) AND INSTR(IncName$, "\") = 0 AND INSTR(IncName$, ":") = 0 THEN
- IncName$ = Path$ + IncName$
- END IF
-
- IF NOT Exist%(IncName$) THEN
- IncName$ = MID$(IncName$, QPLen%(Path$) + 1)
- 'Check envirnment path
- SrchPath IncName$, ENVIRON$("INCLUDE"), NotFound
- IF NotFound THEN FatalErr "Include file " + IncName$ + " not found!"
- END IF
-
- Handle = Handle + 1 'Bump handle
- OPEN IncName$ FOR INPUT AS #Handle 'Open the include file
-
- QPrint0 SPACE$(68), -1 'Display the name of INCLUDE
- QPrint0 "Include File: " + IncName$, -1
-
- Length = 0
- END IF
-
- END IF
- END IF
-
-
- 'Trim left side and remark
- Text$ = LTRIM$(LEFT$(Text$, Length))
-
-
- IF QPLen(Text$) THEN 'If its not a Nul string,
-
- N = INSTR(Text$, CHR$(34)) 'Remove quoted strings
- IF N THEN
- IF INSTR(Text$, "ALIAS") = 0 THEN 'Except Alias name
- Text$ = LEFT$(Text$, N - 1) + MID$(Text$, INSTR(N + 1, Text$, CHR$(34)) + 1)
- END IF
- END IF
-
-
- '~~~~~ Check for each key word
- FOR KW = 0 TO 3
- KWPos = 1
-
- DO
- 'Look for key word
- KWPos = INSTR(KWPos, Text$, KWord$(KW))
-
- IF KWPos > 1 THEN 'Make sure it's a whole word
- IF INSTR(CHR$(32) + CHR$(9), MID$(Text$, KWPos - 1, 1)) = 0 THEN KWPos = 0
-
- 'IF KW < 2 THEN 'Check for valid declare
- ' IF INSTR(Text$, "DECLARE") <> KWPos - 8 THEN KWPos = 0
- 'END IF
- END IF
-
-
- IF KWPos THEN 'If there's a valid key word
-
- '~~~~~ Extract the keyword from the line
- 'Bump pointer to end of key
- KWEnd = KWPos + QPLen%(KWord$(KW))
- 'look for end of proc. name
- FOR P2 = KWEnd + 1 TO QPLen%(Text$)
- IF INSTR(RtnTerm$, MID$(Text$, P2, 1)) THEN EXIT FOR
- NEXT
- 'Extract proceedure name
- LSET Rtn$ = MID$(Text$, KWEnd, P2 - KWEnd)
-
-
- '~~~~~ See if procedure used before in ANY modules
- N = Subs
- FindT Procs(1), ProcLen2 * 2 + 4, N, Rtn$
- IF N = -1 THEN
- N = Subs + 1
- IF N > MaxProcs THEN FatalErr "Too many procedures!"
- ELSE
- N = N + 1
- END IF
-
-
- '~~~~~ See if procedure used before in THIS module
- MS = ModSub(0, M).Count
- ModSub(0, M).ProcName = Rtn$
- FindT ModSub(1, M), ProcLen + 2, MS, ModSub(0, M).ProcName
- IF MS = -1 THEN
- MS = ModSub(0, M).Count + 1
- ModSub(0, M).Count = MS 'Bump number of procedures
- ModSub(MS, M).ProcName = Rtn$ 'Assign Proc. name
- ELSE
- MS = MS + 1
- END IF
-
-
- '~~~~~ If it's a "CALL" or "CALLS",
- IF KW > 1 THEN 'Bump count for routine
- ModSub(MS, M).Count = ModSub(MS, M).Count + 1
- Procs(N).Refed = 2
- END IF
-
-
- '~~~~~ Is this a BASIC proc. definition (SUB/FUNCTION)?
- IF KW < 2 THEN 'AND KWPos = 1 THEN
- IF INSTR(Text$, "DECLARE") <> KWPos - 8 THEN
- Procs(N).BasFlag = BASProc 'Set flag
- 'If referenced befor, set flag
- IF Procs(N).Refed > 1 OR ModSub(MS, M).Count THEN
- Procs(N).BasFlag = RefedProc
- END IF
- END IF
- END IF
-
-
- '~~~~~ If its a new procedure name
- IF N > Subs THEN
- Procs(N).ProcName = Rtn$ 'Assign it
- Subs = N 'Bump number of procedures
- 'Look for an ALIAS name
- Al = INSTR(Text$, "ALIAS")
- IF Al THEN
- Al = Al + 7
- AlEnd = INSTR(Al, Text$, CHR$(34))
- Procs(N).AliasName = MID$(Text$, Al, AlEnd - Al)
- END IF
- 'Is this a BASIC procedure?
- ELSEIF Procs(N).BasFlag = BASProc THEN
- IF Procs(N).Refed > 1 OR ModSub(MS, M).Count THEN
- 'Set flag to show it was
- Procs(N).BasFlag = RefedProc ' referenced
- END IF
- END IF
-
- 'Remove Name so it isn't
- ' found below
- Text$ = LEFT$(Text$, KWEnd - 1) + MID$(Text$, P2)
-
- KWPos = KWPos + 1 'Bump pointer for next word
-
- END IF
-
- LOOP WHILE KWPos AND KW > 1 'Look for more on line
-
- NEXT 'Check for next key word
-
-
- '~~~~~ Look for references to procs. that were declared
- FOR N = 1 TO ModSub(0, M).Count 'Examin text for prev. refs.
-
- IF ModSub(N, M).Count = 0 THEN
-
- look = 0
- DO
- look = INSTR(look + 1, Text$, RTRIM$(ModSub(N, M).ProcName))
-
- IF look THEN
- Start = look
- IF Start > 1 THEN 'Begining of line?
- 'Check Begining of word
- IF INSTR(RtnTerm$, MID$(Text$, Start - 1, 1)) = 0 THEN
- Start = 0
- END IF
- END IF
-
- IF Start THEN 'Check end of word
- PrLen = QPLen%(RTRIM$(ModSub(N, M).ProcName))
- IF INSTR(RtnTerm$, MID$(Text$, Start + PrLen, 1)) THEN
- ModSub(N, M).Count = ModSub(N, M).Count + 1
- 'Check for previous refs.
- LSET Rtn$ = MID$(Text$, Start, PrLen)
- P = Subs
- FindT Procs(1), ProcLen2 * 2 + 4, P, Rtn$
- IF P > -1 THEN
- P = P + 1
- 'Is it a BASIC procedure?
- IF Procs(P).BasFlag THEN
- '~~~~~ Check for function assignment
- IF MID$(Text$, Start + PrLen + 1, 1) = "=" THEN
- 'Decrement counter
- ModSub(N, M).Count = ModSub(N, M).Count - 1
- ELSE 'Show it was referenced
- Procs(P).Refed = 2
- END IF
- ELSE 'Show it was referenced
- Procs(P).Refed = 2
- END IF
- END IF
- END IF
- END IF
- END IF
-
- LOOP WHILE look
-
- END IF
- NEXT
-
- END IF
-
- LOOP 'Read another line of text
-
- CLOSE #1 'Close the module
-
- NEXT 'Read the next module file
-
- ERASE KWord$ 'Clean up string space
- Text$ = ""
-
- LOCATE , 1
- QPrint0 SPACE$(78), -1 'Erase message from screen
-
-
- '~~~~~ Display unreferenced routines
- NoTitle = -1
- FOR M = 1 TO Modules 'For each module
-
- R = FREEFILE 'DAV added this feature so
- UMake$ = LEFT$(Make$(M), LEN(Make$(M)) - 4) + ".UNR" 'unreferenced
- OPEN UMake$ FOR OUTPUT AS #R 'items will be saved
-
- NoModName = -1
- FOR N = 1 TO ModSub(0, M).Count 'For each procedure in module
- IF ModSub(N, M).Count = 0 THEN 'Count of 0 means wasn't used
- 'Look in master list
- P = Subs
- FindT Procs(1), ProcLen2 * 2 + 4, P, ModSub(N, M).ProcName
- P = P + 1
- 'Confirm lack of reference
- IF Procs(P).BasFlag <> RefedProc AND Procs(P).Refed <> 2 THEN
-
- IF NoTitle THEN 'Print error message
- PRINT
- Msg$ = "Note: The following procedures have been declared or defined but never used."
- PRINT Msg$: PRINT #R, Msg$
- NoTitle = 0
- END IF
- IF NoModName THEN 'Print Module name
- Msg$ = Make$(M)
- PRINT Msg$: PRINT #R, Msg$
- NoModName = 0
- END IF
- 'Print procedure name
- PRINT TAB(4); ModSub(N, M).ProcName;
- PRINT #R, TAB(4); ModSub(N, M).ProcName;
- IF Procs(P).BasFlag = BASProc THEN 'Print message
- Msg$ = " is an unused BASIC procedure."
- PRINT Msg$: PRINT #R, Msg$
-
- ELSE
- Msg$ = " was DECLAREd but not used"
- PRINT Msg$; : PRINT #R, Msg$;
- IF Procs(P).Refed <> 2 THEN
- Msg$ = "."
- PRINT Msg$: PRINT #R, Msg$
- Procs(P).BasFlag = 1
- ELSE
- Msg$ = " in this module."
- PRINT Msg$: PRINT #R, Msg$
- Procs(P).BasFlag = 0
- END IF
- END IF
- END IF
- END IF
- NEXT
- CLOSE #R
- NEXT
-
- ERASE ModSub, Make$
- Rtn$ = "": Msg$ = "": UMake$ = ""
-
- END SUB
-
- '~~~~~ Search an environment path for a file
- SUB SrchPath (FileName$, Paths$, NotFound) STATIC
-
- NotFound = -1 'Guilty until proven otherwise
- Path$ = "" 'No Path yet
- PP = 1 'Present position
-
- DO UNTIL Exist(Path$ + FileName$) 'Loop until we find the file
- IF PP > QPLen%(Paths$) THEN EXIT SUB 'Bail out if no more paths
-
- PCP = INSTR(PP, Paths$, ";") 'Find Semicolon position
- IF PCP = 0 THEN PCP = QPLen%(Paths$) + 1 'Last path
- 'Parse out the path
- Path$ = LTRIM$(RTRIM$(MID$(Paths$, PP, PCP - PP)))
- 'Ensure there's a "\" at end
- IF RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
- 'Bump position for next path
- PP = PCP + 1
- LOOP
-
- FileName$ = Path$ + FileName$ 'Add the path to the file name
- NotFound = 0
-
- END SUB
-
- '~~~~~ Prompt User for input
- FUNCTION UserInp$ (NoSemi, Prompt$, Default$) STATIC
-
- PRINT Prompt$; " ["; Default$; "]: ";
- LINE INPUT ""; Temp$
-
- Temp$ = UCASE$(LTRIM$(RTRIM$(Temp$)))
- IF RIGHT$(Temp$, 1) = ";" THEN
- Temp$ = LEFT$(Temp$, QPLen(Temp$) - 1)
- NoSemi = 0
- END IF
- IF QPLen%(Temp$) = 0 THEN Temp$ = Default$
-
- UserInp$ = Temp$
-
- END FUNCTION
-
-